home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / type.c < prev    next >
C/C++ Source or Header  |  1992-10-18  |  3KB  |  94 lines
  1. #include "scheme.h"
  2.  
  3. /*ARGSUSED*/
  4. Dummy_Visit (p, fp) Object *p; int (*fp)(); {
  5.     Panic ("Dummy_Visit");
  6. }
  7.  
  8. /* User-defined types must be greater than T_Last and less than MAX_TYPE.
  9.  */
  10. TYPEDESCR Types[MAX_TYPE] = {
  11.     { 0, "integer",        0, 0, 0, 0, 0, 0, },
  12.     { 1, "integer", /*bignum*/    0, 0, 0, 0, 0, 0, }, 
  13.     { 1, "real",        0, 0, 0, 0, 0, 0, },
  14.     { 0, "null",        0, 0, 0, 0, 0, 0, },
  15.     { 0, "boolean",        0, 0, 0, 0, 0, 0, },
  16.     { 0, "void",        0, 0, 0, 0, 0, 0, },
  17.     { 0, "unbound",        0, 0, 0, 0, 0, 0, },
  18.     { 0, "special",        0, 0, 0, 0, 0, 0, },
  19.     { 0, "character",        0, 0, 0, 0, 0, 0, },
  20.     { 1, "symbol",        0, 0, 0, 0, 0, Dummy_Visit, },
  21.     { 1, "pair",        0, 0, 0, 0, 0, Dummy_Visit, },
  22.     { 1, "environment",        0, 0, 0, 0, 0, Dummy_Visit, },
  23.     { 1, "string",        0, 0, 0, 0, 0, 0, },
  24.     { 1, "vector",        0, 0, 0, 0, 0, Dummy_Visit, },
  25.     { 1, "primitive",        0, 0, 0, 0, 0, 0, },
  26.     { 1, "compound",        0, 0, 0, 0, 0, Dummy_Visit, },
  27.     { 1, "control-point",    0, 0, 0, 0, 0, Dummy_Visit, },
  28.     { 1, "promise",        0, 0, 0, 0, 0, Dummy_Visit, },
  29.     { 1, "port",        0, 0, 0, 0, 0, Dummy_Visit, },
  30.     { 0, "end-of-file",        0, 0, 0, 0, 0, 0, },
  31.     { 1, "autoload",        0, 0, 0, 0, 0, Dummy_Visit, },
  32.     { 1, "macro",        0, 0, 0, 0, 0, Dummy_Visit, },
  33.     { 1, "!!broken-heart!!",    0, 0, 0, 0, 0, 0, },
  34. };
  35.  
  36. Wrong_Type (x, t) Object x; register t; {
  37.     Wrong_Type_Combination (x, Types[t].name);
  38. }
  39.  
  40. Wrong_Type_Combination (x, name) Object x; register char *name; {
  41.     register t = TYPE(x);
  42.     register char *p;
  43.     char buf[100];
  44.  
  45.     if (t < 0 || t >= MAX_TYPE || !(p = Types[t].name))
  46.     Panic ("bad type");
  47.     sprintf (buf, "wrong argument type %s (expected %s)", p, name);
  48.     Primitive_Error (buf);
  49. }
  50.  
  51. Object P_Type (x) Object x; {
  52.     register t = TYPE(x);
  53.     register char *p;
  54.  
  55.     if (t < 0 || t >= MAX_TYPE || !(p = Types[t].name))
  56.     Panic ("bad type");
  57.     return Intern (p);
  58. }
  59.  
  60. /* Not used by the interpreter kernel (lint may complain).
  61.  */
  62. Define_Type (t, name, size, const_size, eqv, equal, print, visit) register t;
  63.     char *name;
  64.     int (*size)(), (*eqv)(), (*equal)(), (*print)(), (*visit)(); {
  65.     register TYPEDESCR *p;
  66.  
  67.     Error_Tag = "define-type";
  68.     if (t == 0) {
  69.     for (t = T_Last+1; t < MAX_TYPE && Types[t].name; t++)
  70.         ;
  71.     if (t == MAX_TYPE)
  72.         Primitive_Error ("out of types");
  73.     } else {
  74.     if (t < 0 || t >= MAX_TYPE)
  75.         Primitive_Error ("bad type");
  76.     if (Types[t].name)
  77.         Primitive_Error ("type already in use");
  78.     }
  79.     p = &Types[t];
  80.     p->haspointer = 1;        /* Assumption */
  81.     p->name = name;
  82.     p->size = size;
  83.     p->const_size = const_size;
  84.     p->eqv = eqv;
  85.     p->equal = equal;
  86.     p->print = print;
  87.     p->visit = visit;
  88.     return t;
  89. }
  90.  
  91. Object P_Voidp (x) Object x; {  /* Don't know a better place for this. */
  92.     return TYPE(x) == T_Void ? True : False;
  93. }
  94.